(library (sets)
(export make-set set? set-elements
        empty-set
        sorted-insert set-insert
        sorted-intersect set-intersect
        sorted-union set-union
        sorted-subset? set-subset?)
(import (chezscheme))

;; (struct set (elements) #:transparent)
(define-record set (elements))

(define empty-set (make-set '()))

(define (sorted-insert x l)
  (cond ((null? l) (list x))
        ((<= x (car l)) (cons x l))
        ((> x (car l)) (cons (car l) (sorted-insert x (cdr l))))))

(define (set-insert x s)
  (make-set (sorted-insert x (set-elements s))))

(define (sorted-intersect s1 s2)
  (cond ((null? s1) '())
        ((null? s2) '())
        (else
         (let ((x (car s1))
               (y (car s2)))
           (cond ((< x y) (sorted-intersect (cdr s1) s2))
                 ((= x y) (cons (car s1) (sorted-intersect (cdr s1) (cdr s2))))
                 ((> x y) (sorted-intersect s1 (cdr s2))))))))

(define (set-intersect s1 s2)
  (make-set (sorted-intersect (set-elements s1) (set-elements s2))))

(define (sorted-union s1 s2)
  (cond ((null? s1) s2)
        ((null? s2) s1)
        (else
         (let ((x (car s1))
               (y (car s2)))
           (cond ((< x y) (cons (car s1) (sorted-union (cdr s1) s2)))
                 ((= x y) (cons (car s1) (sorted-union (cdr s1) (cdr s2))))
                 ((> x y) (cons (car s2) (sorted-union s1 (cdr s2)))))))))

(define (set-union s1 s2)
  (make-set (sorted-union (set-elements s1) (set-elements s2))))

(define (sorted-subset? s1 s2)
  (cond ((null? s1) #t)
        ((null? s2) #f)
        (else
         (let ((x (car s1))
               (y (car s2)))
           (cond ((< x y) #f)
                 ((= x y) (sorted-subset? (cdr s1) s2))
                 ((> x y) (sorted-subset? s1 (cdr s2))))))))

(define (set-subset? s1 s2)
  (sorted-subset? (set-elements s1) (set-elements s2)))

)
